home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1994 November: Tool Chest / Dev.CD Nov 94.toast / Tool Chest / Development Tools & Languages / Macintosh Common Lisp Related / AppleScript-from-lisp / AEStuff.lisp next >
Encoding:
Text File  |  1994-09-12  |  28.0 KB  |  897 lines  |  [TEXT/CCL2]
  1. ;*********************************************
  2. ;*                                           *
  3. ;* AppleEvents <-> Clos Object layer  V 1.02 *
  4. ;*                                           *
  5. ;*     By Philippe  Piernot                  *
  6. ;*        (piernot@ksl.stanford.edu)         *
  7. ;*                                           *
  8. ;* Copyright 1993 by Philippe Piernot.       *
  9. ;* All Rights Reserved.                      *
  10. ;*                                           *
  11. ;* Permission is given to modify and         *
  12. ;* distribute this source code provided that *
  13. ;* the name of the author and this copyright *
  14. ;* notice appear at the top.                 *
  15. ;*                                           *
  16. ;*********************************************
  17.  
  18.  
  19. (in-package :cl-user)
  20. (require :appleevent-toolkit)
  21.  
  22. (defconstant $kAECoreSuite             :|core|)
  23.  
  24. (defconstant $keyAEDesiredClass        :|want|)
  25. (defconstant $keyAEContainer           :|from|)
  26. (defconstant $keyAEKeyForm             :|form|)
  27. (defconstant $keyAEKeyData             :|seld|)
  28.  
  29. (defconstant $typeObjectSpecifier      :|obj |)
  30.  
  31. (defconstant $formAbsolutePosition     :|indx|)
  32. (defconstant $formRelativePosition     :|rele|)
  33. (defconstant $formTest                 :|test|)
  34. (defconstant $formRange                   :|rang|)
  35. (defconstant $formPropertyID           :|prop|)
  36. (defconstant $formName                 :|name|)
  37.  
  38. (defvar *AEToClos* (make-hash-table))
  39. (setf (getHash :|aevt| *AEToClos*) 'AppleEvent)
  40. (setf (getHash :|cmpd| *AEToClos*) 'ComparisonDescriptor)
  41. (setf (getHash :|doub| *AEToClos*) 'Double-Float)
  42. (setf (getHash :|enum| *AEToClos*) 'Keyword)
  43. (setf (getHash :|fals| *AEToClos*) 'Null)
  44. (setf (getHash :|itxt| *AEToClos*) 'String)
  45. (setf (getHash :|list| *AEToClos*) 'List)
  46. (setf (getHash :|long| *AEToClos*) 'Bignum)
  47. (setf (getHash :|magn| *AEToClos*) 'Bignum)
  48. (setf (getHash :|null| *AEToClos*) 'Null)
  49. (setf (getHash :|obj | *AEToClos*) 'ObjectSpecifier)
  50. (setf (getHash :|rang| *AEToClos*) 'RangeDescriptor)
  51. (setf (getHash :|reco| *AEToClos*) 'Hash-Table)
  52. (setf (getHash :|shor| *AEToClos*) 'Fixnum)
  53. (setf (getHash :|sign| *AEToClos*) 'Keyword)
  54. (setf (getHash :|sing| *AEToClos*) 'Single-Float)
  55. (setf (getHash :|ssid| *AEToClos*) 'Fixnum)
  56. (setf (getHash :|TEXT| *AEToClos*) 'String)
  57. (setf (getHash :|true| *AEToClos*) 'T)
  58. (setf (getHash :|type| *AEToClos*) 'Keyword)
  59.  
  60. (defvar *AEToDesc* (make-hash-table))
  61. (setf (getHash :|aevt| *AEToDesc*) 'AppleEvent)
  62. (setf (getHash :|cmpd| *AEToDesc*) 'AERecord)
  63. (setf (getHash :|list| *AEToDesc*) 'AEDescList)
  64. (setf (getHash :|obj | *AEToDesc*) 'AERecord)
  65. (setf (getHash :|rang| *AEToDesc*) 'AERecord)
  66. (setf (getHash :|reco| *AEToDesc*) 'AERecord)
  67. (setf (getHash :|targ| *AEToDesc*) 'AEAddressDesc)
  68.  
  69.  
  70. ;*******************************************************************
  71. ;*                                                                 *
  72. ;* AEDesc Class                                                    * 
  73. ;*                                                                 *
  74. ;*   nullAEDesc         ()                                         *
  75. ;*   fromClosObject     ((self Symbol) &optional object type size) *
  76. ;*   asClosObject       ((self AEDesc))                            *
  77. ;*   dispose            ((self AEDesc))                            *
  78. ;*   getDescriptorType  ((self AEDesc))                            *
  79. ;*   getDataHandle      ((self AEDesc))                            *
  80. ;*   duplicate          ((self AEDesc))                            *
  81. ;*   coerceTo           ((self AEDesc) type)                       *
  82. ;*   putInAE            ((self AEDesc) dataPtr)                    *
  83. ;*   getAEType          ((self AEDesc))                            *
  84. ;*                                                                 *
  85. ;*******************************************************************
  86.  
  87.  
  88. (defclass AEDesc (Standard-Object)
  89.   ((descRecPtr :writer setDescRecPtr
  90.                :reader getDescRecPtr)))
  91.  
  92. (defmethod initialize-Instance ((self AEDesc) &key 
  93.                                 object
  94.                                 (type    (getAEType object))
  95.                                 (recSize (getAESize object))
  96.                                 descRecPtr)
  97.   (unless descRecPtr
  98.     (%stack-Block ((dataPtr recSize))
  99.       (putInAE object dataPtr)
  100.       (setq descRecPtr (make-Record :AEDesc))
  101.       (#_AECreateDesc 
  102.        type 
  103.        dataPtr
  104.        recSize
  105.        descRecPtr)))
  106.   (setDescRecPtr descRecPtr self))
  107.  
  108. (defun nullAEDesc ()
  109.   (make-Instance
  110.     'AEDesc
  111.     :descRecPtr (let ((descRecPtr (make-Record :aedesc)))
  112.                   (#_AECreateDesc 
  113.                    :|null| 
  114.                    (%null-Ptr)
  115.                    0
  116.                    descRecPtr)
  117.                   descRecPtr)))
  118.  
  119. (defmethod fromClosObject ((self Symbol) 
  120.                            object &optional 
  121.                            (type (getAEType object))
  122.                            (size (getAESize object)))
  123.   (make-Instance
  124.     self
  125.     :object  object
  126.     :type    type   
  127.     :recSize size))
  128.  
  129. (defmethod asClosObject ((self AEDesc))
  130.   "Return the AE descriptor as a clos object"
  131.   (fromAEDesc
  132.    (getHash (getDescriptorType self) *AEToClos*)
  133.    self))
  134.  
  135. (defmethod dispose ((self AEDesc))
  136.   (let ((descRecPtr (getDescRecPtr self)))
  137.     (#_AEDisposeDesc descRecPtr)
  138.     (dispose-Record  descRecPtr)))
  139.  
  140. (defmethod getDescriptorType ((self AEDesc))
  141.   (rref (getDescRecPtr self) :AEDesc.descriptorType))
  142.  
  143. (defmethod getDataHandle ((self AEDesc))
  144.   (rref (getDescRecPtr self) :AEDesc.dataHandle))
  145.  
  146. (defmethod duplicate ((self AEDesc))
  147.   (let ((result (make-Record :AEDesc)))
  148.     (#_AEDuplicateDesc
  149.      (getDescRecPtr self)
  150.      result)
  151.     (make-Instance (class-Name (class-Of self)) :descRecPtr result)))
  152.  
  153. (defmethod coerceTo ((self AEDesc) type)
  154.   (let ((result (make-Record :AEDesc)))
  155.     (#_AECoerceDesc
  156.      (getDescRecPtr self)
  157.      type
  158.      result)
  159.     (setDescRecPtr result self)
  160.     (dispose self))
  161.   self)
  162.  
  163. (defmethod getAEType ((self AEDesc))
  164.   (declare (ignore self))
  165.   :|****|)
  166.  
  167.  
  168. ;*************************************************************
  169. ;*                                                           *
  170. ;* AEAddressDesc Class                                       *
  171. ;*                                                           *
  172. ;*   fromPPCBrowser     ((self AEAddressDesc) prompt title)  *
  173. ;*                                                           *
  174. ;*************************************************************
  175.  
  176.  
  177. (defclass AEAddressDesc (AEDesc)
  178.   ())
  179.  
  180. (defmethod initialize-Instance ((self AEAddressDesc) &key
  181.                                 object
  182.                                 type 
  183.                                 recSize
  184.                                 descRecPtr)
  185.   (declare (ignore type) (ignore recSize))
  186.   (unless descRecPtr
  187.     (setq descRecPtr (make-Record :AEDesc))
  188.     (case (class-Name (class-Of object))
  189.       (Cons    (apply 'create-Psn-Target    descRecPtr object))
  190.       (Keyword (ccl::create-Signature-Target     descRecPtr object))
  191.       (String  (create-Named-Process-Target descRecPtr object))
  192.       (Null    (create-Self-Target          descRecPtr))))
  193.   (setDescRecPtr descRecPtr self))
  194.  
  195. (defun fromPPCBrowser (&key
  196.                        (prompt "Choose an Application")
  197.                        (title  "Applications"))
  198.   (make-Instance
  199.     'AEAddressDesc
  200.     :descRecPtr (let ((descRecPtr (make-Record :AEAddressDesc)))
  201.                   (choose-AppleEvent-Target 
  202.                    descRecPtr 
  203.                    :prompt prompt 
  204.                    :title  title)
  205.                   descRecPtr)))
  206.  
  207.  
  208. ;*****************************************************************
  209. ;*                                                               *
  210. ;* AEDescList Class                                              *
  211. ;*                                                               *
  212. ;*   getSize            ((self AEDescList))                      *
  213. ;*   deleteNthItem      ((self AEDescList) index)                *
  214. ;*   setNthItem         ((self AEDescList) index item)           *
  215. ;*   getNthItem         ((self AEDescList) index &optional type) *
  216. ;*   setNthDesc         ((self AEDescList) index desc)           *
  217. ;*   getNthDesc         ((self AEDescList) index &optional type) *
  218. ;*   getAESizeOfNthDesc ((self AEDescList) index)                *
  219. ;*   getAEType          ((self AEDescList))                      *
  220. ;*                                                               *
  221. ;*****************************************************************
  222.  
  223.  
  224. (defclass AEDescList (AEDesc)
  225.   ())
  226.  
  227. (defmethod initialize-Instance ((self AEDescList) &key
  228.                                 object
  229.                                 type 
  230.                                 recSize
  231.                                 descRecPtr)
  232.   (declare (ignore type) (ignore recSize))
  233.   (unless descRecPtr
  234.     (setq descRecPtr (make-Record :AEDescList))
  235.     (#_AECreateList (%null-Ptr) 0 nil descRecPtr)
  236.     (setDescRecPtr descRecPtr self)
  237.     (if object
  238.       (loop for i from 1 to (length object) do
  239.             (setNthItem self i (elt object (1- i))))))
  240.   (setDescRecPtr descRecPtr self))
  241.  
  242. (defmethod getSize ((self AEDescList))
  243.   (rlet ((result :Signed-Long))           
  244.     (#_AECountItems
  245.      (getDescRecPtr self)
  246.      result)
  247.     (%get-Signed-Long result)))
  248.  
  249. (defmethod deleteNthItem ((self AEDescList) index)
  250.   (#_AEDeleteItem
  251.    (getDescRecPtr self)
  252.    index))
  253.  
  254. (defmethod setNthItem ((self AEDescList) index item)
  255.   (let ((desc (asAEDesc item)))
  256.     (setNthDesc self index desc)
  257.     (dispose desc)))
  258.  
  259. (defmethod getNthItem ((self AEDescList) index &optional (type :|****|))
  260.   (multiple-Value-Bind (desc keyword)
  261.     (getNthDesc self index type)
  262.     (let ((item (asClosObject desc)))
  263.       (dispose desc)
  264.       (values item keyword))))
  265.  
  266. (defmethod setNthDesc ((self AEDescList) index desc)
  267.   (#_AEPutDesc 
  268.    (getDescRecPtr self)
  269.    index
  270.    (getDescRecPtr desc)))
  271.  
  272. (defmethod getNthDesc ((self AEDescList) index &optional (type :|****|))
  273.   (let ((result (make-Record :AEDesc))
  274.         (descClass nil))
  275.     (rlet ((keyword :OSType))
  276.       (#_AEGetNthDesc
  277.        (getDescRecPtr self)
  278.        index
  279.        type
  280.        keyword
  281.        result)
  282.       (setq descClass (getHash (rref result :AEDesc.descriptorType) *AEToDesc*))
  283.       (unless descClass
  284.         (setq descClass 'AEDesc))
  285.       (values
  286.        (make-Instance descClass :descRecPtr result)
  287.        (%get-OSType keyword)))))
  288.  
  289. (defmethod getAESizeOfNthDesc ((self AEDescList) index)
  290.   (rlet ((size :Signed-Long)
  291.          (type :OSType))
  292.     (#_AESizeOfNthItem 
  293.      (getDescRecPtr self) 
  294.      index 
  295.      type
  296.      size)
  297.     (values (%get-Signed-Long size) (%get-OSType type))))
  298.  
  299. (defmethod getAEType ((self AEDescList))
  300.   (declare (ignore self))
  301.   :|list|)
  302.  
  303.  
  304. ;*****************************************************************
  305. ;*                                                               *
  306. ;* AERecord Class                                                *
  307. ;*                                                               *
  308. ;*   deleteKeyItem      ((self AERecord) keyword)                *
  309. ;*   setKeyItem         ((self AERecord) keyword item)           *
  310. ;*   getKeyItem         ((self AERecord) keyword &optional type) *
  311. ;*   setKeyDesc         ((self AERecord) keyword desc)           *
  312. ;*   getKeyDesc         ((self AERecord) keyword &optional type) *
  313. ;*   getAESizeOfKeyDesc ((self AERecord) keyword)                *
  314. ;*   getAEType          ((self AERecord))                        *
  315. ;*                                                               *
  316. ;*****************************************************************
  317.  
  318.  
  319. (defclass AERecord (AEDescList)
  320.   ())
  321.  
  322. (defmethod initialize-Instance ((self AERecord) &key
  323.                                 object 
  324.                                 type 
  325.                                 recSize
  326.                                 descRecPtr)
  327.   (declare (ignore type) (ignore recSize))
  328.   (unless descRecPtr
  329.     (setq descRecPtr (make-Record :AERecord))
  330.     (#_AECreateList (%null-Ptr) 0 T descRecPtr)
  331.     (setDescRecPtr descRecPtr self)
  332.     (if object
  333.       (maphash 
  334.        #'(lambda (keyword item)
  335.            (setKeyItem self keyword item))
  336.        object)))
  337.   (setDescRecPtr descRecPtr self))
  338.  
  339. (defmethod deleteKeyItem ((self AERecord) keyword)
  340.   (#_AEDeleteKeyDesc 
  341.    (getDescRecPtr self) 
  342.    keyword))
  343.  
  344. (defmethod setKeyItem ((self AERecord) keyword item)
  345.   (let ((desc (asAEDesc item)))
  346.     (setKeyDesc self keyword desc)
  347.     (dispose desc)))
  348.  
  349. (defmethod getKeyItem ((self AERecord) keyword &optional (type :|****|))
  350.   (let* ((desc (getKeyDesc self keyword type))
  351.          (item (asClosObject desc)))
  352.     (dispose desc)
  353.     item))
  354.  
  355. (defmethod setKeyDesc ((self AERecord) keyword desc)
  356.   (#_AEPutKeyDesc 
  357.    (getDescRecPtr self)
  358.    keyword
  359.    (getDescRecPtr desc)))
  360.  
  361. (defmethod getKeyDesc ((self AERecord) keyword &optional (type :|****|))
  362.   (let ((result (make-Record :AEDesc))
  363.         (descClass nil))
  364.     (#_AEGetKeyDesc 
  365.      (getDescRecPtr self)
  366.      keyword
  367.      type
  368.      result)
  369.     (setq descClass (getHash (rref result :AEDesc.descriptorType) *AEToDesc*))
  370.     (unless descClass
  371.         (setq descClass 'AEDesc))
  372.     (make-Instance descClass :descRecPtr result)))
  373.  
  374. (defmethod getAESizeOfKeyDesc ((self AERecord) keyword)
  375.   (rlet ((size :Signed-Long)
  376.          (type :OSType))
  377.     (#_AESizeOfNthItem 
  378.      (getDescRecPtr self) 
  379.      keyword 
  380.      type
  381.      size)
  382.     (values (%get-Signed-Long size) (%get-OSType type))))
  383.  
  384. (defmethod getAEType ((self AERecord))
  385.   (declare (ignore self))
  386.   :|reco|)
  387.  
  388.  
  389. ;*********************************************************************
  390. ;*                                                                   *
  391. ;* AppleEvent Class                                                  *
  392. ;*                                                                   *
  393. ;*   deleteParam          ((self AppleEvent) keyword)                *
  394. ;*   setParam             ((self AppleEvent) keyword item)           *
  395. ;*   getParam             ((self AppleEvent) keyword &optional type) *
  396. ;*   setParamDesc         ((self AppleEvent) keyword desc)           *
  397. ;*   getParamDesc         ((self AppleEvent) keyword &optional type) *
  398. ;*   getAESizeOfParam     ((self AppleEvent) keyword)                *
  399. ;*   setAttribute         ((self AppleEvent) keyword item)           *
  400. ;*   getAttribute         ((self AppleEvent) keyword &optional type) *
  401. ;*   setAttributeDesc     ((self AppleEvent) keyword desc)           *
  402. ;*   getAttributeDesc     ((self AppleEvent) keyword &optional type) *
  403. ;*   getAESizeOfAttribute ((self AppleEvent) keyword)                *
  404. ;*   getAEType            ((self AppleEvent))                        *
  405. ;*                                                                   *
  406. ;*********************************************************************
  407.  
  408.  
  409. (defclass AppleEvent (AERecord)
  410.   ())
  411.  
  412. (defmethod initialize-instance ((self AppleEvent) &key
  413.                                 object type recSize descRecPtr
  414.                                 class  id   target  
  415.                                 (returnId      #$kAutoGenerateReturnID)
  416.                                 (transactionId #$kAnyTransactionID))
  417.   (declare (ignore object) (ignore type) (ignore recSize))
  418.   (unless descRecPtr
  419.     (setq descRecPtr (make-Record :AppleEvent))
  420.     (#_AECreateAppleEvent
  421.      class
  422.      id 
  423.      (getDescRecPtr target)
  424.      returnId 
  425.      transactionId
  426.      descRecPtr))
  427.   (setDescRecPtr descRecPtr self))
  428.  
  429. (defmethod deleteParam ((self AppleEvent) keyword)
  430.   (#_AEDeleteParam 
  431.    (getDescRecPtr self) 
  432.    keyword))
  433.  
  434. (defmethod setParam ((self AppleEvent) keyword item)
  435.   (let ((desc (asAEDesc item)))
  436.     (setParamDesc self keyword desc)
  437.     (dispose desc)))
  438.  
  439. (defmethod getParam ((self AppleEvent) keyword &optional (type :|****|))
  440.   (let* ((desc (getParamDesc self keyword type))
  441.          (item (asClosObject desc)))
  442.     (dispose desc)
  443.     item))
  444.  
  445. (defmethod setParamDesc ((self AppleEvent) keyword desc)
  446.   (#_AEPutParamDesc 
  447.    (getDescRecPtr self)
  448.    keyword
  449.    (getDescRecPtr desc)))
  450.  
  451. (defmethod getParamDesc ((self AppleEvent) keyword &optional (type :|****|))
  452.   (let ((result (make-Record :AEDesc))
  453.         (descClass nil))
  454.     (#_AEGetParamDesc 
  455.      (getDescRecPtr self)
  456.      keyword
  457.      type
  458.      result)
  459.     (setq descClass (getHash (rref result :aedesc.descriptorType) *AEToDesc*))
  460.     (unless descClass
  461.         (setq descClass 'AEDesc))
  462.     (make-Instance descClass :descRecPtr result)))
  463.  
  464. (defmethod getAESizeOfParam ((self AppleEvent) keyword)
  465.   (rlet ((size :Signed-Long)
  466.          (type :OSType))
  467.     (#_AESizeOfParam 
  468.      (getDescRecPtr self) 
  469.      keyword 
  470.      type
  471.      size)
  472.     (values (%get-Signed-Long size) (%get-OSType type))))
  473.  
  474. (defmethod setAttribute ((self AppleEvent) keyword item)
  475.   (let ((desc (asAEDesc item)))
  476.     (setAttributeDesc self keyword desc)
  477.     (dispose desc)))
  478.  
  479. (defmethod getAttribute ((self AppleEvent) keyword &optional (type :|****|))
  480.   (let* ((desc (getAttributeDesc self keyword type))
  481.          (item (asClosObject desc)))
  482.     (dispose desc)
  483.     item))
  484.  
  485. (defmethod setAttributeDesc ((self AppleEvent) keyword desc)
  486.   (#_AEPutAttributeDesc 
  487.    (getDescRecPtr self)
  488.    keyword
  489.    (getDescRecPtr desc)))
  490.  
  491. (defmethod getAttributeDesc ((self AppleEvent) keyword &optional (type :|****|))
  492.   (let ((result (make-Record :AEDesc))
  493.         (descClass nil))
  494.     (#_AEGetAttributeDesc 
  495.      (getDescRecPtr self)
  496.      keyword
  497.      type
  498.      result)
  499.     (setq descClass (getHash (rref result :AEDesc.descriptorType) *AEToDesc*))
  500.     (unless descClass
  501.         (setq descClass 'AEDesc))
  502.     (make-Instance descClass :descRecPtr result)))
  503.  
  504. (defmethod getAESizeOfAttribute ((self AppleEvent) keyword)
  505.   (rlet ((size :Signed-Long)
  506.          (type :OSType))
  507.     (#_AESizeOfAttribute 
  508.      (getDescRecPtr self) 
  509.      keyword 
  510.      type
  511.      size)
  512.     (values (%get-Signed-Long size) (%get-OSType type))))
  513.  
  514. (defmethod getAEType ((self AppleEvent))
  515.   (declare (ignore self))
  516.   :|aevt|)
  517.  
  518. (defmethod send ((self AppleEvent) &key
  519.                  (reply-mode :no-reply) 
  520.                  (interact-mode nil)
  521.                  (can-switch-layer nil)
  522.                  (dont-reconnect nil)
  523.                  (want-receipt nil) 
  524.                  (priority #$kAENormalPriority)
  525.                  (timeout #$kAEDefaultTimeout)
  526.                  (idleproc appleevent-idle)
  527.                  filterproc)
  528.   (let ((reply (make-Record :aedesc)))
  529.     (send-appleevent 
  530.      (getDescRecPtr self)
  531.      reply
  532.      :reply-mode reply-mode 
  533.      :interact-mode interact-mode
  534.      :can-switch-layer can-switch-layer
  535.      :dont-reconnect dont-reconnect
  536.      :want-receipt want-receipt
  537.      :priority priority
  538.      :timeout timeout
  539.      :idleproc idleproc
  540.      :filterproc filterproc)
  541.     (make-instance 'AppleEvent :descRecPtr reply)
  542.     ))
  543.  
  544.  
  545. ;**************************
  546. ;*                        *
  547. ;* OffsetDescriptor Class *
  548. ;*                        *
  549. ;**************************
  550.  
  551.  
  552. (defclass OffsetDescriptor (AERecord)
  553.   ())
  554.  
  555.  
  556. ;******************************
  557. ;*                            *
  558. ;* ComparisonDescriptor Class *
  559. ;*                            *
  560. ;******************************
  561.  
  562.  
  563. (defclass ComparisonDescriptor (AERecord)
  564.   ())
  565.  
  566.  
  567. ;***************************
  568. ;*                         *
  569. ;* LogicalDescriptor Class *
  570. ;*                         *
  571. ;***************************
  572.  
  573.  
  574. (defclass LogicalDescriptor (AERecord)
  575.   ())
  576.  
  577.  
  578. ;*************************
  579. ;*                       *
  580. ;* RangeDescriptor Class *
  581. ;*                       *
  582. ;*************************
  583.  
  584.  
  585. (defclass RangeDescriptor (AERecord)
  586.   ())
  587.  
  588.  
  589. ;********************************************************
  590. ;*                                                      *
  591. ;* ObjectSpecifier Class                                *
  592. ;*                                                      *
  593. ;*   fromAEDesc ((self (eql 'ObjectSpecifier)) desc)    *
  594. ;*   asAEDesc   ((self ObjectSpecifier) &optional type) *
  595. ;*   getAEType  ((self ObjectSpecifier))                *
  596. ;*                                                      *
  597. ;********************************************************
  598.  
  599.  
  600. (defclass ObjectSpecifier (Standard-Object)
  601.   ((class     :reader getClass
  602.               :writer setClass)
  603.    (container :reader getContainer
  604.               :writer setContainer)
  605.    (form      :reader getForm
  606.               :writer setForm)
  607.    (data      :reader getData
  608.               :writer setData)))
  609.  
  610. (defmethod initialize-instance ((self ObjectSpecifier) &key
  611.                                 class
  612.                                 container
  613.                                 form
  614.                                 data)
  615.   (setClass class self)
  616.   (setContainer container self)
  617.   (setForm form self)
  618.   (setData data self))
  619.  
  620. (defmethod fromAEDesc ((self (eql 'ObjectSpecifier)) desc)
  621.   (declare (ignore self))
  622.   (setq desc (coerceTo desc :|reco|))
  623.   (make-instance
  624.     'ObjectSpecifier
  625.     :class     (getKeyItem desc $keyAEDesiredClass)
  626.     :container (getKeyItem desc $keyAEContainer)
  627.     :form      (getKeyItem desc $keyAEKeyForm)
  628.     :data      (getKeyItem desc $keyAEKeyData)))
  629.  
  630. (defmethod asAEDesc ((self ObjectSpecifier) &optional 
  631.                      (type (getAEType self)))
  632.   (let ((rec  (make-instance 'AERecord))
  633.         (cont (getContainer self))
  634.         (form (make-instance 
  635.                 'AEDesc 
  636.                 :object (getForm self)
  637.                 :type   :|enum|)))
  638.     (setKeyItem rec $keyAEDesiredClass (getClass self))
  639.     (if cont
  640.       (setKeyItem rec $keyAEContainer  cont)
  641.       (setKeyDesc rec $keyAEContainer  (nullAEDesc)))
  642.     (setKeyDesc rec $keyAEKeyForm      form)
  643.     (dispose form)
  644.     (setKeyItem rec $keyAEKeyData      (getData self))
  645.     (coerceTo rec type)))
  646.  
  647. (defmethod getAEType ((self ObjectSpecifier))
  648.   (declare (ignore self))
  649.   :|obj |)
  650.  
  651.  
  652. ;**************************************
  653. ;*                                    *
  654. ;* T Class                            *
  655. ;*                                    *
  656. ;*   fromAEDesc ((self (eql T)) desc) *
  657. ;*   asAEDesc   ((self T))            *
  658. ;*   putInAE    ((self T) dataPtr)    *
  659. ;*   getAEType  ((self T))            *
  660. ;*   getAESize  ((self T))            *
  661. ;*                                    *
  662. ;**************************************
  663.  
  664.  
  665. (defmethod fromAEDesc ((self (eql T)) desc)
  666.   (declare (ignore self) (ignore desc))
  667.   T)
  668.  
  669. (defmethod asAEDesc ((self T) &optional 
  670.                      (type (getAEType self)))
  671.   (make-instance 
  672.     'AEDesc 
  673.     :object self 
  674.     :type   type))
  675.  
  676. (defmethod putInAE ((self T) dataPtr)
  677.   (declare (ignore self))
  678.   (%put-word dataPtr 1))
  679.  
  680. (defmethod getAEType ((self T))
  681.   (declare (ignore self))
  682.   :|true|)
  683.  
  684. (defmethod getAESize ((self T))
  685.   (declare (ignore self))
  686.   2)
  687.  
  688.  
  689. ;******************************************
  690. ;*                                        *
  691. ;* List Class                             *
  692. ;*                                        *
  693. ;*   fromAEDesc ((self (eql 'List)) desc) *
  694. ;*   asAEDesc   ((self List))             *
  695. ;*   getAEType  ((self List))             *
  696. ;*   getAESize  ((self List))             *
  697. ;*                                        *
  698. ;******************************************
  699.  
  700.  
  701. (defmethod fromAEDesc ((self (eql 'List)) descriptorList)
  702.   (declare (ignore self))
  703.   (let ((list '()))
  704.     (loop for i from 1 to (getSize descriptorList) do
  705.       (setq list (append list (list (getNthItem descriptorList i)))))
  706.     list))
  707.  
  708. (defmethod asAEDesc ((self List) &optional 
  709.                      (type (getAEType self)))
  710.   (make-instance 
  711.     'AEDescList
  712.     :object self
  713.     :type   type))
  714.  
  715. (defmethod getAEType ((self List))
  716.   (declare (ignore self))
  717.   :|list|)
  718.  
  719. (defmethod getAESize ((self List))       
  720.   (declare (ignore self)))
  721.  
  722.  
  723. ;************************************************
  724. ;*                                              *
  725. ;* Hash-Table Class                             *
  726. ;*                                              *
  727. ;*   fromAEDesc ((self (eql 'Hash-Table)) desc) *
  728. ;*   getAEType  ((self Hash-Table))             *
  729. ;*   getAESize  ((self Hash-Table))             *
  730. ;*                                              *
  731. ;************************************************
  732.  
  733.  
  734. (defmethod fromAEDesc ((self (eql 'Hash-Table)) aerecord)
  735.   (declare (ignore self))
  736.   (let ((htab  (make-Hash-Table)))
  737.     (loop for i from 1 to (getSize aerecord) do
  738.       (multiple-value-bind (value keyword)
  739.         (getNthItem aerecord i)
  740.         (setf (getHash keyword htab) value)))
  741.     htab))
  742.  
  743. (defmethod asAEDesc ((self Hash-Table) &optional 
  744.                      (type (getAEType self)))
  745.   (make-instance 
  746.     'AERecord
  747.     :object self
  748.     :type   type))
  749.  
  750. (defmethod getAEType ((self Hash-Table))
  751.   (declare (ignore self))
  752.   :|reco|)
  753.  
  754.  
  755. ;********************************************
  756. ;*                                          *
  757. ;* Fixnum Class                             *
  758. ;*                                          *
  759. ;*   fromAEDesc ((self (eql 'Fixnum)) desc) *
  760. ;*   putInAE    ((self Fixnum) dataPtr)     *
  761. ;*   getAEType  ((self Fixnum))             *
  762. ;*   getAESize  ((self Fixnum))             *
  763. ;*                                          *
  764. ;********************************************
  765.  
  766.  
  767. (defmethod fromAEDesc ((self (eql 'Fixnum)) desc)
  768.   (declare (ignore self))
  769.   (%hget-Word (getDataHandle desc)))
  770.  
  771. (defmethod putInAE ((self Fixnum) dataPtr)
  772.   (%put-Word dataPtr self))
  773.  
  774. (defmethod getAEType ((self Fixnum))
  775.   (declare (ignore self))
  776.   :|shor|)
  777.  
  778. (defmethod getAESize ((self Fixnum))
  779.   (declare (ignore self))
  780.   2)
  781.  
  782.  
  783. ;********************************************
  784. ;*                                          *
  785. ;* Bignum Class                             *
  786. ;*                                          *
  787. ;*   fromAEDesc ((self (eql 'Bignum)) desc) *
  788. ;*   putInAE    ((self Bignum) dataPtr)     *
  789. ;*   getAEType  ((self Bignum))             *
  790. ;*   getAESize  ((self Bignum))             *
  791. ;*                                          *
  792. ;********************************************
  793.  
  794.  
  795. (defmethod fromAEDesc ((self (eql 'Bignum)) desc)
  796.   (declare (ignore self))
  797.   (%hget-Long (getDataHandle desc)))
  798.  
  799. (defmethod putInAE ((self Bignum) dataPtr)
  800.   (%put-Long dataPtr self))
  801.  
  802. (defmethod getAEType ((self Bignum))
  803.   (declare (ignore self))
  804.   :|long|)
  805.  
  806. (defmethod getAESize ((self Bignum))
  807.   (declare (ignore self))
  808.   4)
  809.  
  810.  
  811. ;*********************************************
  812. ;*                                           *
  813. ;* Keyword Class                             *
  814. ;*                                           *
  815. ;*   fromAEDesc ((self (eql 'Keyword)) desc) *
  816. ;*   putInAE    ((self Keyword) dataPtr)     *
  817. ;*   getAEType  ((self Keyword))             *
  818. ;*   getAESize  ((self Keyword))             *
  819. ;*                                           *
  820. ;*********************************************
  821.  
  822.  
  823. (defmethod fromAEDesc ((self (eql 'Keyword)) desc)
  824.   (declare (ignore self))
  825.   (%get-OSType (%get-Ptr (getDataHandle desc))))
  826.  
  827. (defmethod putInAE ((self Keyword) dataPtr)
  828.   (%put-OSType dataPtr self))
  829.  
  830. (defmethod getAEType ((self Keyword))
  831.   (declare (ignore self))
  832.   :|type|)
  833.  
  834. (defmethod getAESize ((self Keyword))
  835.   4)
  836.  
  837.  
  838. ;********************************************
  839. ;*                                          *
  840. ;* String Class                             *
  841. ;*                                          *
  842. ;*   fromAEDesc ((self (eql 'String)) desc) *
  843. ;*   putInAE    ((self String) dataPtr)     *
  844. ;*   getAEType  ((self String))             *
  845. ;*   getAESize  ((self String))             *
  846. ;*                                          *
  847. ;********************************************
  848.  
  849.  
  850. (defmethod fromAEDesc ((self (eql 'String)) desc)
  851.   (declare (ignore self))
  852.   (with-dereferenced-handles ((ptr (getDataHandle desc)))
  853.     (ccl::%str-from-ptr ptr (#_GetHandleSize (getDataHandle desc)))))
  854.  
  855. (defmethod putInAE ((self String) dataPtr)
  856.   (%put-CString dataPtr self))
  857.  
  858. (defmethod getAEType ((self String))
  859.   (declare (ignore self))
  860.   :|TEXT|)
  861.  
  862. (defmethod getAESize ((self String))
  863.   (length self))
  864.  
  865.  
  866. ;******************************************
  867. ;*                                        *
  868. ;* Null Class                             *
  869. ;*                                        *
  870. ;*   fromAEDesc ((self (eql 'Null)) desc) *
  871. ;*   putInAE    ((self Null) dataPtr)     *
  872. ;*   getAEType  ((self Null))             *
  873. ;*   getAESize  ((self Null))             *
  874. ;*                                        *
  875. ;******************************************
  876.  
  877.  
  878. (defmethod fromAEDesc ((self (eql 'Null)) desc)
  879.   (declare (ignore self) (ignore desc))
  880.   nil)
  881.  
  882. (defmethod putInAE ((self Null) dataPtr)
  883.   (declare (ignore self))
  884.   (%put-Word dataPtr 0))
  885.  
  886. (defmethod getAEType ((self Null))
  887.   (declare (ignore self))
  888.   :|fals|)
  889.  
  890. (defmethod getAESize ((self Null))
  891.   (declare (ignore self))
  892.   2)
  893.  
  894.  
  895.  
  896.  
  897.